home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / defoma / libperl-hint.pl < prev    next >
Encoding:
Text File  |  2006-06-21  |  10.5 KB  |  454 lines
  1. my @GENERALFAMILY_LIST;
  2. my @WEIGHT_LIST;
  3. my @SHAPE_LIST;
  4.  
  5. $DIALOGTITLE = '';
  6. $DWIDTH = 70;
  7. $SUFFIXPATH = '';
  8.  
  9. $result = 0;
  10.  
  11. my %PARSEHINTS;
  12. my %F2G = ();
  13. my $NOQUESTION = 0;
  14.  
  15. sub parse_all_hints_conf {
  16.     my $key = shift;
  17.     my $listptr = shift;
  18.  
  19.     $PARSEHINTS{$key} = $listptr;
  20. }
  21.  
  22. sub parse_all_hints_init {
  23.     @GENERALFAMILY_LIST = ('Roman', 'SansSerif', 'Typewriter', 'Symbol',
  24.              'Gothic', 'Mincho');
  25.     @WEIGHT_LIST = ('Medium', 'Bold', 'Semibold', 'Light', 'Semilight');
  26.     @SHAPE_LIST = ('Serif', 'NoSerif', 'Upright', 'Oblique', 'Italic',
  27.            'Condensed', 'Expanded');
  28.     %PARSEHINTS = ();
  29.  
  30.     parse_all_hints_conf('GeneralFamily', \@GENERALFAMILY_LIST);
  31.     parse_all_hints_conf('Weight', \@WEIGHT_LIST);
  32.     parse_all_hints_conf('Shape', \@SHAPE_LIST);
  33. }
  34.  
  35. sub parse_all_hints {
  36.     my @hints = ();
  37.  
  38.     foreach my $c (keys(%Debian::Defoma::Font::Fobjs)) {
  39.     foreach my $f (defoma_font_get_fonts($c)) {
  40.         my @h = defoma_font_get_hints($c, $f);
  41.         next unless (@h);
  42.         while ($h[0] !~ /^--/) {
  43.         shift(@h);
  44.         }
  45.         push(@hints, @h);
  46.     }
  47.     }
  48.  
  49.     my $h = parse_hints_start(@hints);
  50.  
  51.     foreach my $k (keys(%PARSEHINTS)) {
  52.     my $listptr = $PARSEHINTS{$k};
  53.     my %kso = ();
  54.  
  55.     foreach my $i (@{$listptr}) {
  56.         $kso{$i} = undef;
  57.     }
  58.  
  59.     foreach my $i (split(' ', $h->{$k})) {
  60.         push(@{$listptr}, $i) unless (exists($kso{$i}));
  61.         $kso{$i} = undef;
  62.     }
  63.     }
  64. }
  65.  
  66. sub fileselector {
  67.     my $text = shift;
  68.     my $origdir = `/bin/pwd`;
  69.     chomp($origdir);
  70.     my $file;
  71.     my $retfile = '';
  72.  
  73.     my $dtitle = $DIALOGTITLE;
  74.     $DIALOGTITLE = 'File Selector';
  75.  
  76.     while (1) {
  77.     my $dir=`/bin/pwd`;
  78.     chomp($dir);
  79.  
  80.     my @dirs = ();
  81.     my @files = ();
  82.     my @list;
  83.  
  84.     opendir(DIR, '.');
  85.     @list = readdir(DIR);
  86.     closedir(DIR);
  87.  
  88.     foreach $file (@list) {
  89.         next if ($file eq '.');
  90.         
  91.         if (-d $file) {
  92.         push(@dirs, "$file/");
  93.         } else {
  94.         push(@files, $file);
  95.         }
  96.     }
  97.  
  98.     @files = sort { $a cmp $b } (@files);
  99.     @dirs = sort { $a cmp $b } (@dirs);
  100.     
  101.     my $ddir = $dir;
  102.     my $len = length($ddir);
  103.     if ($len > 60) {
  104.         $len -= 60;
  105.         $ddir =~ s/^.{$len}//;
  106.     }
  107.  
  108.     my $desc = "$text\\n\\nDir: $ddir";
  109.     $file = menu_single($desc, 10, '', @dirs, @files);
  110.     $file =~ s@/$@@;
  111.  
  112.     last if ($result != 0);
  113.  
  114.     if (-d $file) {
  115.         chdir $file;
  116.     } else {
  117.         $retfile = "$dir/$file";
  118.         last;
  119.     }
  120.     }
  121.  
  122.     $DIALOGTITLE = $dtitle;
  123.     chdir $origdir;
  124.  
  125.     return $retfile;
  126. }
  127.  
  128. sub msgbox_q {
  129.     unless ($NOQUESTION) {
  130.     msgbox(@_);
  131.     }
  132. }
  133.  
  134. sub input_checklist_q {
  135.     if ($NOQUESTION) {
  136.     return $_[1];
  137.     } else {
  138.     return input_checklist(@_);
  139.     }
  140. }
  141.  
  142. sub input_menu_q {
  143.     if ($NOQUESTION) {
  144.     return $_[1] if ($_[1] ne '');
  145.     return $_[6] if (@_ >= 7);
  146.     return '';
  147.     } else {
  148.     return input_menu(@_);
  149.     }
  150. }
  151.  
  152. sub input_fontname {
  153.     my $default = shift;
  154.     my $text = <<EOF
  155. Input the FontName of the font.
  156. * FontName should be and must be a font-specific identifier. For example,
  157. * a font of FooBar family, Bold weight and Italic shape should have
  158. * FooBar-BoldItalic as the FontName.
  159. EOF
  160.     ;
  161.  
  162.     return input_menu_q($text, $default, '[^ \t]', 0);
  163. }
  164.  
  165. sub input_family {
  166.     my $font = shift;
  167.     my $default = shift;
  168.     my $text = <<EOF
  169. Input the Family of $font.
  170. * Family of the font is similar to a family name of a person. A font
  171. * often has some decorated derivative fonts, but all of the derivative
  172. * fonts and its original font share a common name. Family is exactly
  173. * the shared common name. For example, Times-Roman has three decorated
  174. * versions, Times-Italic, Times-Bold and Times-BoldItalic, and Family
  175. * of them is Times.
  176. EOF
  177.     ;
  178.  
  179.     return input_menu_q($text, $default, '[^ \t]', 0);
  180. }
  181.  
  182. sub input_generalfamily {
  183.     my $font = shift;
  184.     my $family = shift;
  185.     my $text = <<EOF
  186. Choose the GeneralFamily of $font.
  187. * GeneralFamily represents the rough group which the font belongs to.
  188. * This hint is useful for substitution of fonts, because fonts which
  189. * belong to the same GeneralFamily are supposed to have more similar
  190. * font faces than those which do not.
  191. Following is a list of standard General Families (Roman, SansSerif,
  192. Typewriter, Symbol, Gothic, and Mincho) and already registered General
  193. Families. Please choose GeneralFamily from the list, or None if you
  194. want to input a new GeneralFamily manually.
  195. EOF
  196.     ;
  197.  
  198.     my $default = exists($F2G{$family}) ? $F2G{$family} : '';
  199.  
  200.     my $ret = input_menu_q('Input the GeneralFamily of the font manually.',
  201.              $default, '[^ \t]', 0, '<None>', $text,
  202.              @GENERALFAMILY_LIST, '<None>');
  203.     if ($result == 0) {
  204.     $F2G{$family} = $ret;
  205.     }
  206.  
  207.     return $ret;
  208. }
  209.  
  210. sub input_weight {
  211.     my $font = shift;
  212.     my $default = shift;
  213.     my $menutext = <<EOF
  214. Choose the Weight of $font.
  215. * Weight represends the heaviness of the appearance, or the thickness
  216. * of lines of glyphs, of the font.
  217. Following is a list of standard Weights (Medium, Bold, Semibold, Light,
  218. and Semilight) and already registered Weights. Please choose Weight from
  219. the list, or None if you want to input a new Weight manually.
  220. EOF
  221.     ;
  222.  
  223.     return input_menu_q('Input the Weight of the font manually.', $default,
  224.               '[^ \t]', 0, '<None>', $menutext, @WEIGHT_LIST,
  225.               '<None>');
  226. }
  227.  
  228. sub input_width {
  229.     my $font = shift;
  230.     my $default = shift;
  231.     my $menutext = <<EOF
  232. Choose the Width of $font.
  233. * Width specifies whether the width of glyphs of the font varies, or is
  234. * fixed. Typewriter fonts are maybe famous fixed width fonts. Most Latin
  235. * fonts are variable width ones. Kanji fonts are also regarded as fixed
  236. * width.
  237. EOF
  238.     ;
  239.  
  240.     return input_menu_q('', $default, '', 0, '', $menutext, 'Variable', 'Fixed');
  241. }
  242.  
  243. sub input_shape {
  244.     my $font = shift;
  245.     my $default = shift;
  246.     my @dlist = split(' ', $default);
  247.     my $slant = '';
  248.     my $serif = '';
  249.     my $width = '';
  250.     my $ret;
  251.  
  252.     for (my $i = 0; $i < @dlist; $i++) {
  253.     $slant = $dlist[$i] if ($dlist[$i] =~ /^(Upright|Italic|Oblique)$/);
  254.     $width = $dlist[$i] if ($dlist[$i] =~ /^(Condensed|Expanded)$/);
  255.     $serif = $dlist[$i] if ($dlist[$i] =~ /^(Serif|NoSerif)$/);
  256.     }
  257.  
  258.     $width = 'Normal' if ($width eq '');
  259.     $slant = 'Upright' if ($slant eq '');
  260.  
  261.     my $text = <<EOF
  262. Choose the Shapes of $font.
  263. * Shape represents additional information about the appearance of glyphs
  264. * of the font. This Hint category consists of several types of font faces,
  265. * including Serif, Slant, and the extent of Width. The last one, Width
  266. * hint here is absolutely different from Fixed/Variable Width hint, which
  267. * is supposed to be already chosen.
  268. Following is a list of candidates of hints about Shape of the font. Mark
  269. the hints applicable to the font, by Space key.
  270. EOF
  271.     ;
  272.     $text =~ s/\n/\\n/gm;
  273.  
  274.     my @hlist;
  275.     unless ($NOQUESTION) {
  276.     $ret = checklist_single_onargs($text, 9, "$width $slant $serif",
  277.                        @SHAPE_LIST);
  278.     
  279.     @hlist = split(/\n/, $ret);
  280.     } else {
  281.     @hlist = split(' ', "$width $slant $serif");
  282.     }
  283.     
  284.     $slant = '';
  285.     $width = '';
  286.     $serif = '';
  287.     
  288.     for ($i = 0; $i < @hlist; $i++) {
  289.     if ($hlist[$i] =~ /^(Upright|Oblique|Italic)$/) {
  290.         if ($slant eq '') {
  291.         $slant = $hlist[$i];
  292.         } elsif ($slant =~ /^(Oblique|Italic)$/ &&
  293.              $hlist[$i] =~ /^(Oblique|Italic)$/) {
  294.         $slant = 'Italic';
  295.         } else {
  296.         $text = "$slant and $hlist[$i] confclicts. ";
  297.         $text .= "Which is correct?";
  298.         $slant = menu_single($text, 2, '', $slant, $hlist[$i]);
  299.         }
  300.         $hlist[$i] = '';
  301.     }
  302.     if ($hlist[$i] =~ /^(Expanded|Condensed)$/) {
  303.         if ($width eq '') {
  304.         $width = $hlist[$i];
  305.         } else {
  306.         $text = "$width and $hlist[$i] confclicts.";
  307.         $text .= "Which is correct?";
  308.         $width = menu_single($text, 2, '', $width, $hlist[$i]);
  309.         }
  310.         $hlist[$i] = '';
  311.     }
  312.     if ($hlist[$i] =~ /^(Serif|NoSerif)$/) {
  313.         if ($serif eq '') {
  314.         $serif = $hlist[$i];
  315.         } else {
  316.         $text = "$serif and $hlist[$i] conflict.";
  317.         $text .= "Which is correct?";
  318.         $serif = menu_single($text, 2, '', $serif, $hlist[$i]);
  319.         }
  320.         $hlist[$i] = '';
  321.     }
  322.     }
  323.  
  324.     $default = join(' ', @hlist, $serif, $slant, $width);
  325.     $default =~ s/\s+/ /g;
  326.     
  327.     return input_menu_q('Add the Shapes of the font.', $default, '.', 1);
  328. }
  329.  
  330. sub input_alias {
  331.     my $font = shift;
  332.     my $default = shift;
  333.     my $text = <<EOF
  334. Input the Alias(es) of $font, if exists. 
  335. * Alias represents other FontName(s) of a font. Specifying them will
  336. * make the font accessible by the alias(es).
  337. You can specify more than one aliases by separating them by space.
  338. EOF
  339.     ;
  340.  
  341.     return input_menu_q($text, $default, '[^ \t]', 1);
  342. }
  343.  
  344. sub input_priority {
  345.     my $font = shift;
  346.     my $default = shift;
  347.     my $text = <<EOF
  348. Input the Priority of $font between 0 and 99.
  349. * Priority is used when more than one fonts provide the same identifier
  350. * in ID cache. The font which has the largest Priority of them will 
  351. * actually get installed.
  352. EOF
  353.     ;
  354.  
  355.     return input_menu_q($text, $default, '[0-9]', 0);
  356. }
  357.  
  358. sub input_xlfd {
  359.     my $font = shift;
  360.     my $text = <<EOF
  361. Input the X-FontName of $font.
  362. * X-FontName specifies the XLFD(s) of the font in case if it is used
  363. * in X. Defoma does not touch the configuration of X so X-FontName
  364. * does not affect the actual XLFD(s) of the font, but is worth setting
  365. * for applications which want to know available XLFDs with their
  366. * detailed hints.
  367. You can set more than one XLFDs by separating them by space. If XLFD 
  368. contains spaces, replace them with underscore(_).
  369. EOF
  370.     ;
  371.  
  372.     return input_menu_q($text, '', '.', 1);
  373. }
  374.  
  375. sub input_afm {
  376.     my $font = shift;
  377.     my $dir = shift;
  378.     my $text = <<EOF
  379. Select the AFM file of $font.
  380. * AFM file represents font metrics in ascii format. It is used
  381. * for typesetting.
  382. Select Cancel if AFM file is missing.
  383. EOF
  384.     ;
  385.  
  386.     return '' if $NOQUESTION;
  387.  
  388.     my $odir = `/bin/pwd`;
  389.     chomp($odir);
  390.     
  391.     chdir($dir) if (defined($dir));
  392.  
  393.     my $ret = fileselector($text);
  394.  
  395.     chdir($odir);
  396.     
  397.     return '' if ($result == 1);
  398.     return $ret unless ($result);
  399.  
  400.     return;
  401. }
  402.  
  403. sub lhints2hints {
  404.     my $lhints = shift;
  405.     my @list = split(' ', $lhints);
  406.     my $i;
  407.     my $line;
  408.     my @lines;
  409.     
  410.     my $flag = 0;
  411.     foreach $i (@list) {
  412.     if ($i =~ /^--/) {
  413.         $i =~ s/^--//;
  414.  
  415.         push(@lines, $line) if ($flag);
  416.         $line = "  $i";
  417.         $flag = 1;
  418.     } elsif ($flag) {
  419.         $line .=  ($flag > 1) ? ' ' : ' = ';
  420.         $line .= $i;
  421.         $flag = 2;
  422.     }
  423.     }
  424.     push(@lines, $line) if ($flag);
  425.  
  426.     return @lines;
  427. }
  428.  
  429. sub hint_beginlib {
  430.     $DIALOGTITLE = shift;
  431.     $DWIDTH = shift;
  432.     my $mode = shift;
  433.     $SUFFIXPATH = shift || '';
  434.     $NOQUESTION = shift;
  435.     
  436.     parse_all_hints_init();
  437.     parse_all_hints();
  438.  
  439.     
  440.  
  441.     if ($ENV{'DISPLAY'} && -f "$LIBDIR/libgtk.pl" && $mode ne 'c') {
  442.     require("$LIBDIR/libgtk.pl");
  443.     if ($@) {
  444.         require("$LIBDIR/libconsole.pl");
  445.     }
  446.     } else {
  447.     require("$LIBDIR/libconsole.pl");
  448.     }
  449.  
  450.     
  451. }
  452.  
  453. 1;
  454.